home *** CD-ROM | disk | FTP | other *** search
/ Amiga Format CD 41 / Amiga Format CD41 (1999-06)(Future Publishing)(GB)[!][issue 1999-07].iso / -seriously_amiga- / programming / other / scm / slib / lineio.scm < prev    next >
Text File  |  1999-04-19  |  3KB  |  90 lines
  1. ; "lineio.scm", line oriented input/output functions for Scheme.
  2. ; Copyright (c) 1992, 1993 Aubrey Jaffer
  3. ;
  4. ;Permission to copy this software, to redistribute it, and to use it
  5. ;for any purpose is granted, subject to the following restrictions and
  6. ;understandings.
  7. ;
  8. ;1.  Any copy made of this software must include this copyright notice
  9. ;in full.
  10. ;
  11. ;2.  I have made no warrantee or representation that the operation of
  12. ;this software will be error-free, and I am under no obligation to
  13. ;provide any services, by way of maintenance, update, or otherwise.
  14. ;
  15. ;3.  In conjunction with products arising from the use of this
  16. ;material, there shall be no use of my name in any advertising,
  17. ;promotional, or sales literature without prior written consent in
  18. ;each case.
  19.  
  20.  
  21. ;;@args read-line
  22. ;;@args read-line port
  23. ;;Returns a string of the characters up to, but not including a
  24. ;;newline or end of file, updating @var{port} to point to the
  25. ;;character following the newline.  If no characters are available, an
  26. ;;end of file object is returned.  The @var{port} argument may be
  27. ;;omitted, in which case it defaults to the value returned by
  28. ;;@code{current-input-port}.
  29. (define (read-line . port)
  30.   (let* ((char (apply read-char port)))
  31.     (if (eof-object? char)
  32.     char
  33.     (do ((char char (apply read-char port))
  34.          (clist '() (cons char clist)))
  35.         ((or (eof-object? char) (char=? #\newline char))
  36.          (list->string (reverse clist)))))))
  37.  
  38. ;;@args read-line! string
  39. ;;@args read-line! string port
  40. ;;Fills @1 with characters up to, but not including a newline or end
  41. ;;of file, updating the @var{port} to point to the last character read
  42. ;;or following the newline if it was read.  If no characters are
  43. ;;available, an end of file object is returned.  If a newline or end
  44. ;;of file was found, the number of characters read is returned.
  45. ;;Otherwise, @code{#f} is returned.  The @var{port} argument may be
  46. ;;omitted, in which case it defaults to the value returned by
  47. ;;@code{current-input-port}.
  48. (define (read-line! str . port)
  49.   (let* ((char (apply read-char port))
  50.      (len (+ -1 (string-length str))))
  51.     (if (eof-object? char)
  52.     char
  53.     (do ((char char (apply read-char port))
  54.          (i 0 (+ 1 i)))
  55.         ((or (eof-object? char)
  56.          (char=? #\newline char)
  57.          (>= i len))
  58.          (cond ((or (eof-object? char) (char=? #\newline char))
  59.             i)
  60.            (else
  61.             (string-set! str i char)
  62.             (set! char (apply peek-char port))
  63.             (if (or (eof-object? char) (char=? #\newline char))
  64.             (+ 1 i) #f))))
  65.       (string-set! str i char)))))
  66.  
  67.  
  68. ;;@args write-line string
  69. ;;@args write-line string port
  70. ;;Writes @1 followed by a newline to the given @var{port} and returns
  71. ;;an unspecified value.  The @var{Port} argument may be omited, in
  72. ;;which case it defaults to the value returned by
  73. ;;@code{current-input-port}.@refill
  74. (define (write-line str . port)
  75.   (apply display str port)
  76.   (apply newline port))
  77.  
  78. ;;@args path
  79. ;;@args path port
  80. ;;Displays the contents of the file named by @1 to @var{port}.  The
  81. ;;@var{port} argument may be ommited, in which case it defaults to the
  82. ;;value returned by @code{current-output-port}.
  83. (define (display-file path . port)
  84.   (set! port (if (null? port) (current-output-port) (car port)))
  85.   (call-with-input-file path
  86.     (lambda (inport)
  87.       (do ((line (read-line inport) (read-line inport)))
  88.       ((eof-object? line))
  89.     (write-line line port)))))
  90.